home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt3sp1.arc
/
KSEND1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-10-05
|
22KB
|
537 lines
(*----------------------------------------------------------------------*)
(* Check_Init --- Check initialization packet from host *)
(*----------------------------------------------------------------------*)
PROCEDURE Check_Init( VAR Check_OK : BOOLEAN );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Check_Init *)
(* *)
(* Purpose: Interprets initialization packet from host *)
(* *)
(* Calling Sequence: *)
(* *)
(* Check_Init( VAR Check_OK : BOOLEAN ); *)
(* *)
(* Check_OK --- If initialization packet was OK *)
(* *)
(* Remarks: *)
(* *)
(* The initialization packet interpreted here has the following *)
(* entries: *)
(* *)
(* Byte Contents *)
(* ---- --------------------------------- *)
(* 1 Maximum packet size in bytes *)
(* 2 Time out value in seconds *)
(* 3 Number of pad characters *)
(* 4 Padding character *)
(* 5 End of line character *)
(* 6 Control-quoting character *)
(* 7 8th bit quote character *)
(* 8 Block check type *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Packet_Length : INTEGER;
Quote_8 : CHAR;
BEGIN (* Check_Init *)
(* Check that packet number is OK *)
IF Rec_Packet_Num = ( Packet_Num MOD 64 ) THEN
Check_OK := TRUE;
Packet_Length := LENGTH( Rec_Packet );
(* Check packet length *)
IF Packet_Length >= 1 THEN
IF Kermit_UnChar( Rec_Packet[1] ) IN [4..94] THEN
Kermit_Packet_Size := Kermit_UnChar(Rec_Packet[1])
ELSE
Check_OK := FALSE;
(* Determine what other Kermit *)
(* wants. *)
IF Check_OK THEN
BEGIN
(* TimeOut value *)
IF Packet_Length >= 2 THEN
IF Rec_Packet[2] <> ' ' THEN
His_TimeOut := Kermit_UnChar( Rec_Packet[2] );
(* Number of pad characters *)
IF Packet_Length >= 3 THEN
IF Rec_Packet[3] <> ' ' THEN
My_Pad_Num := Kermit_UnChar( Rec_Packet[3] )
ELSE
My_Pad_Num := Kermit_Npad;
(* Padding character *)
IF Packet_Length >= 4 THEN
IF Rec_Packet[4] <> ' ' THEN
My_Pad_Char := Kermit_Ctrl( Rec_Packet[4] )
ELSE
My_Pad_Char := Kermit_Pad_Char;
(* End-of-line character *)
IF Packet_Length >= 5 THEN
IF Rec_Packet[5] <> ' ' THEN
Send_EOL := Kermit_UnChar( Rec_Packet[5] )
ELSE
Send_EOL := ORD( Kermit_EOL );
(* Control-quoting character *)
IF Packet_Length >= 6 THEN
BEGIN
IF ( Rec_Packet[6] = ' ' ) THEN
His_Quote_Char := Kermit_Quote_Char
ELSE
His_Quote_Char := Rec_Packet[6];
END
ELSE
His_Quote_Char := Kermit_Quote_Char;
(* 8th-bit quoting character *)
IF ( Packet_Length >= 7 ) THEN
CASE Rec_Packet[7] OF
(* Not quoting *)
'N' : Quoting := FALSE;
(* Willing to quote but won't *)
'Y', ' ' : ;
(* Use specified quoting character *)
'!'..'>','`'..'~' : BEGIN
Quoting := TRUE;
His_Quote_8_Char := Rec_Packet[7];
END;
(* Valid quote char not received *)
ELSE
Check_OK := FALSE;
END (* CASE *)
(* Remote system not acknowledging *)
(* quoting. *)
ELSE
IF Quoting THEN
Check_OK := FALSE;
(* Block check type *)
IF Packet_Length >= 8 THEN
IF Rec_Packet[8] <> ' ' THEN
His_Chk_Type := Rec_Packet[8]
ELSE
His_Chk_Type := '1';
END (* IF Check_OK *);
Quoting := Quoting AND ( ( Data_Bits <> 8 ) OR
( Parity <> 'N' ) ) AND
( Kermit_File_Type_Var = Kermit_Binary );
(* Display the parameter values *)
Display_Kermit_Init_Params;
END (* Check_Init *);
(*----------------------------------------------------------------------*)
(* Check_ACK --- Check ACK State for most packets *)
(*----------------------------------------------------------------------*)
PROCEDURE Check_ACK;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Check_ACK *)
(* *)
(* Purpose: Checks ACK status for most packets *)
(* *)
(* Calling Sequence: *)
(* *)
(* Check_ACK; *)
(* *)
(* Remarks: *)
(* *)
(* The packet to be sent is in Packet_Buffer. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
A_Ch: CHAR;
BEGIN (* Check_ACK *)
(* Assume bad packet to start *)
ACK_OK := FALSE;
(* Pick up a packet *)
Receive_Packet;
IF Packet_OK AND ( NOT Kermit_Abort ) THEN
BEGIN
(* Check if ACK or NAK packet received. *)
(* May also be error packet. *)
CASE Kermit_Packet_Type OF
(* Make sure ACK is for correct block *)
ACK_Pack : IF ( Rec_Packet_Num = ( Packet_Num MOD 64 ) ) THEN
ACK_OK := TRUE;
NAK_Pack : BEGIN
IF ( Rec_Packet_Num = 0 ) THEN
Rec_Packet_Num := 63
ELSE
Rec_Packet_Num := Rec_Packet_Num - 1;
(* NAK for next is ACK for present *)
IF ( Rec_Packet_Num = ( Packet_Num MOD 64 ) ) THEN
ACK_OK := TRUE;
END;
(* Error packet sent *)
Error_Pack : BEGIN
GoToXY( 25 , 5 );
WRITE( '>> Error from remote Kermit <<' );
ClrEol;
Kermit_Abort := TRUE;
GoToXY( 2 , 8 );
WRITE( Rec_Packet );
ClrEol;
GoToXY( 2 , 9 );
WRITE('Hit any key to continue ... ');
READ( Kbd, A_Ch );
IF ( ORD( A_Ch ) = ESC ) AND KeyPressed THEN
READ( Kbd, A_Ch );
END;
(* Something else -- don't ACK it *)
ELSE
ACK_OK := FALSE;
END (* CASE *)
END
ELSE
ACK_OK := FALSE;
IF ( NOT ACK_OK ) THEN
BEGIN
Packets_Bad := Packets_Bad + 1;
Update_Kermit_Display;
END;
END (* Check_ACK *);
(*----------------------------------------------------------------*)
(* Send_Packet --- send a packet *)
(*----------------------------------------------------------------*)
PROCEDURE Send_Packet;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Send_Packet *)
(* *)
(* Purpose: Sends a Kermit packet to remote host *)
(* *)
(* Calling Sequence: *)
(* *)
(* Send_Packet; *)
(* *)
(* Remarks: *)
(* *)
(* The packet to be sent is in Packet_Buffer. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Count: INTEGER;
StrNum: STRING[3];
BEGIN (* Send_Packet *)
(* Purge input buffer before send *)
Async_Purge_Buffer;
(* Send this packet *)
Async_Send_String( Packet_Buffer );
(* Update packets sent count *)
Packets_Sent := Packets_Sent + 1;
Update_Kermit_Display;
END (* Send_Packet *);
(*----------------------------------------------------------------*)
(* Build_Packet --- Build a packet *)
(*----------------------------------------------------------------*)
PROCEDURE Build_Packet;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Build_Packet *)
(* *)
(* Purpose: Builds a Kermit packet *)
(* *)
(* Calling Sequence: *)
(* *)
(* Build_Packet; *)
(* *)
(* Remarks: *)
(* *)
(* This routine add the block number and checksum to the data in *)
(* Packet_Buffer_Data. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
CheckSum : INTEGER;
Count : INTEGER;
Index : INTEGER;
Bit_Count : INTEGER;
Temp_Pack : Kermit_Packet_String;
CheckSum_String : STRING[3];
A_Byte : BYTE;
Check_Type : INTEGER;
BEGIN (* Build_Packet *)
(* Add block header, length, packet *)
(* number to front of packet data *)
Check_Type := ORD( His_Chk_Type ) - ORD('0');
Packet_Buffer := Kermit_Header_Char +
Kermit_Char40( LENGTH( Packet_Buffer_Data ) + Check_Type + 1 ) +
Kermit_Char40( Packet_Num MOD 64 ) + Packet_Buffer_Data;
(* Calculate checksum/crc *)
CheckSum := 0;
CASE His_Chk_Type OF
'1': BEGIN
FOR Count := 2 TO LENGTH( Packet_Buffer ) DO
CheckSum := CheckSum + ORD( Packet_Buffer[ Count ] );
CheckSum := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) ) AND 63 );
CheckSum_String := Kermit_Char40( CheckSum );
END;
'2': BEGIN
FOR Count := 2 TO LENGTH( Packet_Buffer ) DO
CheckSum := CheckSum + ORD(Packet_Buffer[Count]);
CheckSum := CheckSum AND 4095;
CheckSum_String := Kermit_Char40( CheckSum SHR 6 ) +
Kermit_Char40( CheckSum AND 63 );
END;
'3': BEGIN
FOR Count := 2 TO LENGTH( Packet_Buffer ) DO
BEGIN
A_Byte := ORD( Packet_Buffer[Count] );
CheckSum := Kermit_CRC( CheckSum , A_Byte );
END;
CheckSum_String := Kermit_Char40( ( CheckSum SHR 12 ) AND 63 ) +
Kermit_Char40( ( CheckSum SHR 6 ) AND 63 ) +
Kermit_Char40( CheckSum AND 63 );
END;
END (* CASE *);
(* Append checksum, end of line *)
(* character to packet. *)
Packet_Buffer := Packet_Buffer + CheckSum_String + CHR( Send_EOL );
(* Add requested padding *)
IF ( My_Pad_Num > 0 ) THEN
FOR Count := 1 TO My_Pad_Num DO
Packet_Buffer := My_Pad_Char + Packet_Buffer;
END (* Build_Packet *);
(*----------------------------------------------------------------*)
(* Kermit_Finish_Server --- Finish server mode transfers *)
(*----------------------------------------------------------------*)
PROCEDURE Kermit_Finish_Server;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Kermit_Finish_Server *)
(* *)
(* Purpose: Tells remote Kermit server to quit *)
(* *)
(* Calling Sequence: *)
(* *)
(* Kermit_Finish_Server; *)
(* *)
(* Remarks: *)
(* *)
(* This routine sends the 'FINISH' packet, not the 'LOGOUT' *)
(* packet. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Try : INTEGER;
BEGIN (* Kermit_Finish_Server *)
(* Build FINISH packet *)
Packet_Buffer_Data := 'GF';
Packet_Num := 0;
Try := 0;
Build_Packet;
(* Don't update display *)
Logging_Out_Server := TRUE;
(* Send FINISH packet until *)
(* acknowledged or too many *)
(* tries. *)
REPEAT
Try := Try + 1;
Send_Packet;
Check_ACK;
UNTIL ( Kermit_Abort OR ACK_OK OR ( Try > Kermit_MaxTry ) );
IF ( Try > Kermit_MaxTry ) OR Kermit_Abort THEN
BEGIN
GoToXY( 25 , 5 );
WRITE('Error ...');
ClrEol;
GoToXY( 1 , 7 );
WRITE('Unable to tell remote server to quit.');
ClrEol;
DELAY( One_Second_Delay );
END;
Logging_Out_Server := FALSE;
END (* Kermit_Finish_Server *);
(*----------------------------------------------------------------------*)
(* Send_ACK --- Send acknowledge for a packet *)
(*----------------------------------------------------------------------*)
PROCEDURE Send_ACK;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Send_ACK *)
(* *)
(* Purpose: Sends acknowledge for packet to host *)
(* *)
(* Calling Sequence: *)
(* *)
(* Send_ACK; *)
(* *)
(* Calls: *)
(* *)
(* Build_Packet; *)
(* Send_Packet; *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Save_CHK: CHAR;
Quote_8 : CHAR;
BEGIN (* Send_ACK *)
IF ( Kermit_State = Receive_Init ) OR
( Kermit_State = Get_File ) THEN
BEGIN
IF Quoting THEN
Quote_8 := 'Y'
ELSE
Quote_8 := 'N';
Packet_Buffer_Data := 'Y' + Kermit_Char40( Kermit_Packet_Size ) +
Kermit_Char40( Kermit_TimeOut ) +
Kermit_Char40( My_Pad_Num ) +
Kermit_Ctrl ( My_Pad_Char ) +
Kermit_Char40( Send_EOL ) +
His_Quote_Char +
Quote_8 +
His_Chk_Type;
Save_CHK := His_Chk_Type;
His_Chk_Type := '1';
Build_Packet;
Send_Packet;
His_Chk_Type := Save_CHK;
END
ELSE
BEGIN
Packet_Buffer_Data := 'Y';
Build_Packet;
Send_Packet;
END;
END (* Send_ACK *);
(*----------------------------------------------------------------------*)
(* Send_NAK --- Send negative acknowledge for a packet *)
(*----------------------------------------------------------------------*)
PROCEDURE Send_NAK;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Send_NAK *)
(* *)
(* Purpose: Sends negative acknowledge for packet to host *)
(* *)
(* Calling Sequence: *)
(* *)
(* Send_NAK; *)
(* *)
(* Calls: *)
(* *)
(* Build_Packet; *)
(* Send_Packet; *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* Send_NAK *)
Packet_Buffer_Data := 'N';
Build_Packet;
Send_Packet;
END (* Send_NAK *);